home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dualsort.arc / CALLS20.BAS next >
BASIC Source File  |  1987-08-15  |  3KB  |  104 lines
  1. ' Demo program to show how to sort on two fields at one pass.
  2. ' This is an extract from a PCB 12.0 utility I am working on.
  3. ' Warren Lauzon, SYSOP, Phoenix Techline, 602 936 3058
  4. ' EVI 2496, 1200-9600 baud
  5.  
  6.  
  7.  
  8. common shared Linenumber!, logst$, filesize!, dnlds%, filename$, lastdate$
  9.  
  10. common shared filename$(1)
  11. dim filename$(5000)
  12.  
  13. CONST true = -1, ok = -1, done = -1
  14. defint a-z
  15.  
  16. ' You will have to change this portion to the actual path & filename
  17. ' on your system.  It uses the caller file, gets all the downloaded
  18. ' file names, sorts them by date and then by name.  This is a portion
  19. ' of a utility I am working on.  The sort fields are arbitrary, done
  20. ' only for illustration of how to sort on two fields.
  21.  
  22. callfile$ = command$
  23. if callfile$ = "" then callfile$ = "c:\basic\caller"
  24.  
  25. open callfile$ FOR random as #1 len = 64
  26. 'open "c:\basic\file$.dat" FOR append as #2
  27. filesize! = LOF(1)/64
  28.  
  29. REM $INCLUDE: 'frame.bas'
  30.  
  31. starttime! = timer  ' for test purposes only
  32. color 10,7
  33. call frame (10, 70, 5, 20)
  34. call frame (12, 68, 6, 19)
  35.  
  36. FOR Linenumber! = 1 to filesize!
  37.     get #1, Linenumber!
  38.     line input #1, logst$
  39.     if instr(logst$, ":") = 3 then
  40.         lastdate$ = mid$(logst$, 8, 8)
  41.     end if
  42.     if instr(logst$, "[D]") then
  43.         if instr(logst$, "Completed") then call dnlds
  44.     end if
  45.     st$ = str$(linenumber!)
  46.     call xqprintd(st$, 11, 37, 110, 0)
  47. next Linenumber!
  48.  
  49. sub dnlds static    ' gets name and fills it out to 20 spaces, adds date
  50.     filename$(dnlds%) = mid$(logst$, (instr(logst$, "[D] " ) + 4), (instr(logst$, "Comp") -12))
  51.     pad$ = space$(20)
  52.     lset pad$ = filename$(dnlds%)
  53.     filename$(dnlds%) = pad$ + lastdate$
  54.     dnlds% = dnlds% + 1
  55. END sub
  56.  
  57. call sort(filename$())  ' call the sort with one parameter
  58.  
  59. cls
  60.  
  61. for i = 0 to dnlds%
  62.     if left$(filename$(i),12) <> left$(filename$(i+1), 12) then
  63.         print filename$(i)
  64.     end if
  65.     next i
  66. endtime! = timer
  67. locate 12, 36
  68. print using "###.##"; endtime! - starttime!
  69. END
  70.  
  71.  
  72.  
  73. SUB sort (name$(1)) static      'shellsort routine
  74.  
  75.     length% = dnlds%
  76.     jump% = 1
  77.     WHILE jump% <= length%
  78.         jump% = jump% * 2
  79.     WEND
  80.             ' note that it must be swapped once on one field, then
  81.             ' only swapped again if the first fields are equal, other-
  82.             ' wise you can get into an endless loop of continual swapping.
  83.  
  84.     WHILE jump% > 1
  85.         jump% = (jump% -1) \ 2
  86.         finished% = false%
  87.         WHILE not finished%
  88.             finished% = true%
  89.             FOR upper% = 1 to length% - jump%
  90.                 lower% = upper% + jump%
  91.                 if mid$(name$(upper%),21,8) < mid$(name$(lower%),21,8) then
  92.                     swap name$(upper%), name$(lower%) ' first swap
  93.                 end if
  94.                 if mid$(name$(upper%),21,8) = mid$(name$(lower%),21,8) _
  95.                     and mid$(name$(upper%),1,12) > mid$(name$(lower%),1,12) then
  96.                     swap name$(upper%), name$(lower%)  'second swap
  97.                 finished% = false%
  98.                 end if
  99.             next upper%
  100.         WEND
  101.     WEND
  102. END SUB
  103.  
  104.